home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / system / tkhtml-2.3 / tkhtml-2 / tkHTML-2.3 / tix / SListbox.tcl < prev    next >
Encoding:
Text File  |  1995-02-12  |  7.1 KB  |  285 lines
  1. proc tixScrolledListBox {w args} {
  2.     eval tixInt_CreateWidget $w tixSlb TixScrolledListbox $args
  3.     return $w
  4. }
  5.  
  6. proc tixScrolledListbox {w args} {
  7.     eval tixInt_CreateWidget $w tixSlb TixScrolledListbox $args
  8.     return $w
  9. }
  10.  
  11. proc tixSlb::CreateClassRec {} {
  12.     global tixSlb
  13.  
  14.     # OPTIONS
  15.     set tixSlb(rootOptions)   {}
  16.     set tixSlb(options)       {-scrollbar -anchor
  17.                    -foreground -fg
  18.                    -background -bg
  19.                    -font
  20.                    -geometry -geom -listboxbg
  21.                    -scrollbarbg -scrollbarfg
  22.                                -scrollbarwidth -scbwidth
  23.                   }
  24.  
  25.  
  26.     # DEFAULT VALUES
  27.     set tixSlb(-anchor)         {-anchor anchor Anchor w}
  28.     set tixSlb(-background)     {-background background Background #ffe4c4}
  29.     set tixSlb(-foreground)     {-foreground foreground Foreground black}
  30.     set tixSlb(-scrollbarwidth) {-scrollbarwidth scrollbarWidth
  31.                               ScrollbarWidth 15}
  32.     set tixSlb(-geometry)       {-geometry geometry Geometry 10x10}
  33.     set tixSlb(-listboxbg)      {-listboxbg listboxBg Background #ffe4c4}
  34.     set tixSlb(-scrollbarbg)    {-scrollbarbg scrollbarBg ScrollbarBg #dfc4a4}
  35.     set tixSlb(-scrollbarfg)    {-scrollbarfg scrollbarFg ScrollbarFg #ffe4c4}
  36.     set tixSlb(-scrollbar)      {-scrollbar scrollbar Scrollbar both}
  37.     set tixSlb(-font)           {-font font Font \
  38.                          "-*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*"}
  39.  
  40.     # ALIASES
  41.     set tixSlb(-geom)           {= -geometry}
  42.     set tixSlb(-bg)             {= -background}
  43.     set tixSlb(-fg)             {= -foreground}
  44.     set tixSlb(-scbwidth)       {= -scrollbarwidth}
  45.  
  46.     # METHODS
  47.     set tixSlb(methods)       {listbox info}
  48. }
  49.  
  50. proc tixSlb::InitWidgetRec {w class className args} {
  51.     upvar #0 $w data
  52.  
  53.     set data(width)          0
  54.     set data(height)         0
  55.     set data(xview)          0
  56.     set data(yview)          0
  57.     set data(totalwidth)     0
  58.     set data(totalheight)    0
  59.     set data(type)           nil
  60.     set data(flag)           0
  61. }
  62.  
  63. proc tixSlb::ConstructWidget {w} {
  64.     upvar #0 $w data
  65.  
  66.     frame $w.f1 -border 0
  67.     frame $w.f2 -border 0
  68.  
  69.     scrollbar $w.sb1 \
  70.     -width $data(-scrollbarwidth) \
  71.     -bg $data(-scrollbarbg) \
  72.     -fg $data(-scrollbarfg) \
  73.     -orient horiz \
  74.     -command "$w.lb1 xview"
  75.  
  76.     scrollbar $w.sb2 \
  77.     -width $data(-scrollbarwidth) \
  78.     -bg $data(-scrollbarbg) \
  79.     -fg $data(-scrollbarfg) \
  80.     -command "$w.lb1 yview"
  81.  
  82.     listbox $w.lb1 \
  83.     -exportselection false \
  84.     -xscrollcommand "tixSlb::MonitorSize $w width $w.sb1"  \
  85.     -yscrollcommand "tixSlb::MonitorSize $w height $w.sb2" \
  86.     -font $data(-font) \
  87.     -bg $data(-listboxbg) \
  88.     -fg $data(-foreground) \
  89.     -geom $data(-geometry)
  90.  
  91.     frame $w.fx -height $data(-scrollbarwidth) -relief flat \
  92.     -width [expr "$data(-scrollbarwidth) + 2 * [lindex [$w.sb2 config -bd] 4]"] \
  93.     -bg $data(-background)
  94.  
  95.     set data(listbox) $w.lb1
  96.     set data(hsb)     $w.sb1
  97.     set data(vsb)     $w.sb2
  98.     set data(xframe)  $w.fx
  99.     tixSlb::Repack $w $data(-scrollbar)
  100.  
  101.     bind $w.sb1 <1>                "+set [format "%s(flag)" $w] 1"
  102.     bind $w.sb1 <ButtonRelease-1>  "+set [format "%s(flag)" $w] 0"
  103. }
  104.  
  105. proc tixSlb::ScrollBarsNeeded {w} {
  106.     upvar #0 $w data
  107.  
  108.     if {$data(totalwidth) > $data(width)} {
  109.     if {$data(totalheight) > $data(height) || $data(yview) > 0 } {
  110.         return both
  111.     } else {
  112.         return x
  113.     }
  114.     } elseif {$data(totalheight) > $data(height) || $data(yview) > 0 } {
  115.     return y
  116.     } else {
  117.     return none
  118.     }
  119. }
  120.  
  121. proc tixSlb::Repack {w type} {
  122.     upvar #0 $w data
  123.  
  124.     if {$type == "auto"} {
  125.     set type [tixSlb::ScrollBarsNeeded $w]
  126.     }
  127.  
  128.     if {$type != $data(type)} {
  129.     pack forget $data(listbox)
  130.     pack forget $data(hsb)
  131.     pack forget $data(vsb)
  132.     pack forget $data(xframe)
  133.     pack forget $w.f1
  134.     pack forget $w.f2
  135.  
  136.     tixSlb::Pack $w $type
  137.     set data(type) $type
  138.     }
  139. }
  140.  
  141. proc tixSlb::Pack {w type} {
  142.     upvar #0 $w data
  143.  
  144.     if {$type == "both"} {
  145.     pack $data(listbox) -in $w.f1 -side left -fill both -expand yes
  146.     pack $data(vsb)     -in $w.f1 -side left -fill y
  147.  
  148.     pack $data(hsb)     -in $w.f2 -side left -fill x -expand yes
  149.     pack $data(xframe)  -in $w.f2 -side left -fill y
  150.  
  151.     pack $w.f2 -side bottom -fill x
  152.     pack $w.f1 -side top -fill both -expand yes
  153.     } elseif {$type == "x"} {
  154.     pack $data(hsb)     -side bottom -fill x
  155.     pack $data(listbox) -side top -fill both -expand yes
  156.     } elseif {$type == "y"} {
  157.     pack $data(vsb)     -side right -fill y
  158.     pack $data(listbox) -side left -fill both -expand yes
  159.     } else {
  160.     pack $data(listbox) -fill both -expand yes
  161.     }
  162. }
  163.  
  164. #----------------------------------------------------------------------
  165. #                           CONFIG OPTIONS
  166. #----------------------------------------------------------------------
  167. proc tixSlb::config-anchor {w arg} {
  168.     puts stderr "TixScrolledListbox: config anchor not implemented"
  169. }
  170.  
  171. proc tixSlb::config-background {w arg} {
  172.     upvar #0 $w data
  173.  
  174.     $data(rootCmd) config -bg $arg
  175.     $data(xframe)  config -bg $arg
  176. }
  177.  
  178. proc tixSlb::config-foreground {w arg} {
  179.     upvar #0 $w data
  180.  
  181.     $data(listbox) config -fg $arg
  182. }
  183.  
  184. proc tixSlb::config-scrollbarfg {w arg} {
  185.     upvar #0 $w data
  186.  
  187.     $data(hsb) config -fg $arg
  188.     $data(vsb) config -fg $arg
  189. }
  190.  
  191. proc tixSlb::config-scrollbarbg {w arg} {
  192.     upvar #0 $w data
  193.  
  194.     $data(hsb) config -bg $arg
  195.     $data(vsb) config -bg $arg
  196. }
  197.  
  198. proc tixSlb::config-listboxbg {w arg} {
  199.     upvar #0 $w data
  200.  
  201.     $data(listbox) config -bg $arg
  202. }
  203.  
  204. proc tixSlb::config-font {w arg} {
  205.     upvar #0 $w data
  206.  
  207.     $data(listbox) config -font $arg
  208. }
  209.  
  210. proc tixSlb::config-scrollbar {w arg} {
  211.     upvar #0 $w data
  212. }
  213.  
  214. proc tixSlb::config-scrollbarwidth {w arg} {
  215.     upvar #0 $w data
  216.  
  217.     $data(hsb) config -width $arg
  218.     $data(vsb) config -width $arg
  219.  
  220.     $data(xframe) config -height $arg \
  221.       -width [expr "$arg + 2 * [lindex [$data(vsb) config -bd] 4]"]
  222. }
  223.  
  224. proc tixSlb::config-geometry {w arg} {
  225.     upvar #0 $w data
  226.  
  227.     $data(listbox) config -geometry $arg
  228. }
  229. #----------------------------------------------------------------------
  230. #                     WIDGET COMMANDS
  231. #----------------------------------------------------------------------
  232. proc tixSlb::listbox {w args} {
  233.     upvar #0 $w data
  234.  
  235.     if {$args != {}} {
  236.     return [eval $data(listbox) $args]
  237.     } else {
  238.     return $data(listbox)
  239.     }
  240. }
  241.  
  242. proc tixSlb::info {w spec} {
  243.     upvar #0 $w data
  244.  
  245.     if {$spec == "width" || $spec == "height"} {
  246.     return $data($spec)
  247.     }
  248.     if {$spec == "totalwidth" || $spec == "totalheight"} {
  249.     return $data($spec)
  250.     }
  251.     if {$spec == "xview" || $spec == "yview"} {
  252.     return $data($spec)
  253.     }
  254. }
  255.  
  256. #----------------------------------------------------------------------
  257. #                     Internal commands
  258. #----------------------------------------------------------------------
  259. proc tixSlb::MonitorSize {w spec scb total max begin end} {
  260.     upvar #0 $w data
  261.  
  262.     set data($spec) $max
  263.     set data(total$spec) $total
  264.     if {$spec == "width"} {
  265.     set data(xview) $begin
  266.     } else {
  267.     set data(yview) $begin
  268.     }
  269.     $scb set $total $max $begin $end
  270.  
  271.     if {$data(-scrollbar) == "auto"} {
  272.     tixSlb::Repack $w auto
  273.     }
  274.  
  275.     if {$data(flag) == 0} {
  276.     if {$data(-anchor) == "e"} {
  277.         set data(flag) 1
  278.         if {$total > $max && $total > [expr $end +1]} {
  279.         $data(listbox) xview [expr "$total - $max + 1"]
  280.         }
  281.         set data(flag) 0
  282.     }
  283.     }
  284. }
  285.